home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 039a / mawk.zip / EXECUTE.C < prev    next >
C/C++ Source or Header  |  1991-04-09  |  27KB  |  928 lines
  1.  
  2. /********************************************
  3. execute.c
  4. copyright 1991, Michael D. Brennan
  5.  
  6. This is a source file for mawk, an implementation of
  7. the Awk programming language as defined in
  8. Aho, Kernighan and Weinberger, The AWK Programming Language,
  9. Addison-Wesley, 1988.
  10.  
  11. See the accompaning file, LIMITATIONS, for restrictions
  12. regarding modification and redistribution of this
  13. program in source or binary form.
  14. ********************************************/
  15.  
  16. /* $Log:    execute.c,v $
  17.  * Revision 2.2  91/04/09  12:38:54  brennan
  18.  * added static to funct decls to satisfy STARDENT compiler
  19.  * 
  20.  * Revision 2.1  91/04/08  08:22:55  brennan
  21.  * VERSION 0.97
  22.  * 
  23. */
  24.  
  25.  
  26. #include "mawk.h"
  27. #include "code.h"
  28. #include "memory.h"
  29. #include "symtype.h"
  30. #include "field.h"
  31. #include "bi_funct.h"
  32. #include "regexp.h"
  33. #include "repl.h"
  34. #include <math.h>
  35.  
  36. /* static functions */
  37. static int PROTO( compare, (CELL *) ) ;
  38. static void PROTO( eval_overflow, (void) ) ;
  39.  
  40. #ifdef   DEBUG
  41. #define  inc_sp()   if( ++sp == eval_stack+EVAL_STACK_SIZE )\
  42.                          eval_overflow()
  43. #else
  44.  
  45. /* If things are working, the only reason the eval stack should
  46.    overflow is too much function recursion
  47.    (checked for at _CALL below  */
  48.  
  49. #define inc_sp()    sp++
  50. #endif
  51.  
  52. #define  SAFETY    3    /* if we get within 3 of stack top emit 
  53.          overflow */
  54.  
  55. /*  The stack machine that executes the code */
  56.  
  57. CELL  eval_stack[EVAL_STACK_SIZE] ;
  58.  
  59. static void eval_overflow()
  60. { overflow("eval stack" , EVAL_STACK_SIZE) ; mawk_exit(1) ; }
  61.  
  62. /* if this flag is on, recursive calls to execute need to
  63.    return to the _CALL statement.  This only happens
  64.    inside array loops */
  65. int  returning ;  
  66.  
  67. INST  *execute(cdp, sp, fp)
  68.   register INST *cdp ;  /* code ptr, start execution here */
  69.   register CELL *sp ;   /* eval_stack pointer */
  70.   CELL *fp ;            /* frame ptr into eval_stack for
  71.                            user defined functions */
  72. { 
  73.   /* some useful temporaries */
  74.   CELL *cp , tc ;
  75.   int t ;
  76.  
  77. #ifdef  DEBUG
  78.   CELL *entry_sp = sp ;
  79. #endif
  80.  
  81.   while ( 1 )
  82.     switch( cdp++ -> op )
  83.     {   case  _HALT :
  84.         case  _STOP :  
  85.  
  86. #ifdef   DEBUG
  87. /* check the stack is sane */
  88.                 if ( sp != entry_sp ) bozo("stop") ;
  89.                 return cdp - 1 ;
  90.  
  91.         case  _STOP0  : /* if debugging stops range patterns */
  92.                 if ( sp != entry_sp+1 ) bozo("stop0") ;
  93. #else
  94.         case  _STOP0  :
  95. #endif
  96.                 return cdp -  1 ;
  97.  
  98.         case  _PUSHC :  
  99.             inc_sp() ;
  100.             (void) cellcpy(sp, cdp++ -> ptr) ;
  101.             break ;
  102.  
  103.         case  F_PUSHA :
  104.             if ( (CELL*)cdp->ptr != field && nf < 0 ) split_field0() ;
  105.             /* fall thru */
  106.  
  107.         case  _PUSHA :
  108.         case  A_PUSHA :
  109.             inc_sp() ;
  110.             sp -> ptr = cdp++ -> ptr ;
  111.             break ;
  112.  
  113.         case _PUSHI :  /* put contents of next address on stack*/
  114.             inc_sp() ;
  115.             (void) cellcpy(sp, cdp++ -> ptr) ;
  116.             break ;
  117.             
  118.         case L_PUSHI :  
  119.             /* put the contents of a local var on stack,
  120.                cdp->op holds the offset from the frame pointer */
  121.             inc_sp() ;
  122.             (void) cellcpy(sp, fp + cdp++->op) ;
  123.             break ;
  124.  
  125.         case L_PUSHA : /* put a local address on eval stack */
  126.             inc_sp() ;
  127.             sp->ptr = (PTR)(fp + cdp++->op) ;
  128.             break ;
  129.  
  130.  
  131.         case F_PUSHI :
  132.  
  133.         /* note $0 , RS , FS and OFMT are loaded by _PUSHI */
  134.  
  135.             inc_sp() ;
  136.             if ( nf < 0 )  split_field0() ;
  137.             if ( (t = (CELL *) cdp->ptr - field) <= nf ||
  138.                   t == NF  )
  139.             { (void) cellcpy(sp, cdp++ -> ptr) ; }
  140.             else  /* an unset field */
  141.             { sp->type = C_STRING ;
  142.               sp->ptr = (PTR) & null_str ;
  143.               null_str.ref_cnt++ ;
  144.               cdp++ ;
  145.             }
  146.             break ;
  147.  
  148.         case  FE_PUSHA :
  149.             if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  150.             if ( (t = (int) sp->dval) < 0 )
  151.                 rt_error( "negative field index(%d)", t) ;
  152.             if ( t > MAX_FIELD )
  153.                 rt_overflow("MAX_FIELD", MAX_FIELD) ;
  154.             if ( t && nf < 0 )  split_field0() ;
  155.             sp->ptr = (PTR) &field[t] ;
  156.             break ;
  157.  
  158.         case  FE_PUSHI :
  159.             if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  160.  
  161.             if ( (t = (int) sp->dval) == 0 )
  162.             { (void) cellcpy(sp, &field[0]) ; break ; }
  163.  
  164.             if ( t < 0 )
  165.                   rt_error( "negative field index(%d)", t) ;
  166.             if ( t > MAX_FIELD )
  167.                   rt_overflow("MAX_FIELD", MAX_FIELD) ;
  168.  
  169.             if ( nf < 0)  split_field0() ;
  170.             if ( t <= nf ) (void) cellcpy(sp, &field[t]) ;
  171.             else
  172.             { sp->type = C_STRING ;
  173.               sp->ptr = (PTR) & null_str ;
  174.               null_str.ref_cnt++ ;
  175.             }
  176.             break ; 
  177.  
  178.  
  179.         case  AE_PUSHA :
  180.         /* top of stack has an expr, cdp->ptr points at an
  181.            array, replace the expr with the cell address inside
  182.            the array */
  183.             cast1_to_s(sp) ;
  184.             cp = array_find((ARRAY)cdp++->ptr, sp->ptr, 0) ;
  185.             free_STRING( string(sp) );
  186.             sp->ptr = (PTR) cp ;
  187.             break ;
  188.  
  189.         case  AE_PUSHI :
  190.         /* top of stack has an expr, cdp->ptr points at an
  191.            array, replace the expr with the contents of the
  192.            cell inside the array */
  193.             cast1_to_s(sp) ;
  194.             cp = array_find((ARRAY) cdp++->ptr, sp->ptr, 0) ;
  195.             free_STRING(string(sp)) ;
  196.             (void) cellcpy(sp, cp) ;
  197.             break ;
  198.  
  199.         case  LAE_PUSHI :
  200.         /*  sp[0] is an expression
  201.             cdp->op is offset from frame pointer of a CELL which
  202.                has an ARRAY in the ptr field, replace expr
  203.             with  array[expr]
  204.         */
  205.             cast1_to_s(sp) ;
  206.             cp = array_find( (ARRAY)fp[cdp++->op].ptr, sp->ptr, 0) ;
  207.             free_STRING(string(sp)) ;
  208.             (void) cellcpy(sp, cp) ;
  209.             break ;
  210.             
  211.         case  LAE_PUSHA :
  212.         /*  sp[0] is an expression
  213.             cdp->op is offset from frame pointer of a CELL which
  214.                has an ARRAY in the ptr field, replace expr
  215.             with  & array[expr]
  216.         */
  217.             cast1_to_s(sp) ;
  218.             cp = array_find( (ARRAY)fp[cdp++->op].ptr, sp->ptr, 0) ;
  219.             free_STRING(string(sp)) ;
  220.             sp->ptr = (PTR) cp ;
  221.             break ;
  222.             
  223.         case  LA_PUSHA  :
  224.         /*  cdp->op is offset from frame pointer of a CELL which
  225.                has an ARRAY in the ptr field. Push this ARRAY
  226.                on the eval stack
  227.         */
  228.             inc_sp() ;
  229.             sp->ptr = fp[cdp++->op].ptr ;
  230.             break ;
  231.  
  232.         case  A_LOOP :
  233.             cdp = array_loop(cdp,sp,fp) ;
  234.             if ( returning ) return cdp ; /*value doesn't matter*/
  235.             sp -= 2 ;
  236.             break ;
  237.  
  238.         case  _POP : 
  239.             cell_destroy(sp) ;
  240.             sp-- ;
  241.             break ;
  242.  
  243.         case _DUP  :
  244.             (void) cellcpy(sp+1, sp) ;
  245.             sp++ ; break ;
  246.  
  247.         case  _ASSIGN :
  248.             /* top of stack has an expr, next down is an
  249.                address, put the expression in *address and
  250.                replace the address with the expression */
  251.  
  252.             /* don't propagate type C_MBSTRN */
  253.             if ( sp->type == C_MBSTRN ) check_strnum(sp) ;
  254.             sp-- ;
  255.             cell_destroy( ((CELL *)sp->ptr) ) ;
  256.             (void) cellcpy( sp, cellcpy(sp->ptr, sp+1) ) ;
  257.             cell_destroy(sp+1) ;
  258.             break ;
  259.  
  260.         case  F_ASSIGN : /* assign to a field  */
  261.             if (sp->type == C_MBSTRN) check_strnum(sp) ;
  262.             sp-- ;
  263.             field_assign((CELL*)sp->ptr - field, sp+1) ;
  264.             cell_destroy(sp+1) ;
  265.             (void) cellcpy(sp, (CELL *) sp->ptr) ;
  266.             break ;
  267.  
  268.         case  _ADD_ASG:
  269.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  270.             cp = (CELL *) (sp-1)->ptr ;
  271.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  272.             cp->dval += sp-- -> dval ;
  273.             sp->type = C_DOUBLE ;
  274.             sp->dval = cp->dval ;
  275.             break ;
  276.  
  277.         case  _SUB_ASG:
  278.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  279.             cp = (CELL *) (sp-1)->ptr ;
  280.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  281.             cp->dval -= sp-- -> dval ;
  282.             sp->type = C_DOUBLE ;
  283.             sp->dval = cp->dval ;
  284.             break ;
  285.  
  286.         case  _MUL_ASG:
  287.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  288.             cp = (CELL *) (sp-1)->ptr ;
  289.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  290.             cp->dval *= sp-- -> dval ;
  291.             sp->type = C_DOUBLE ;
  292.             sp->dval = cp->dval ;
  293.             break ;
  294.  
  295.         case  _DIV_ASG:
  296.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  297.             cp = (CELL *) (sp-1)->ptr ;
  298.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  299.             cp->dval /= sp-- -> dval ;
  300.             sp->type = C_DOUBLE ;
  301.             sp->dval = cp->dval ;
  302.             break ;
  303.  
  304.         case  _MOD_ASG:
  305.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  306.             cp = (CELL *) (sp-1)->ptr ;
  307.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  308.             cp->dval = fmod(cp->dval,sp-- -> dval) ;
  309.             sp->type = C_DOUBLE ;
  310.             sp->dval = cp->dval ;
  311.             break ;
  312.  
  313.         case  _POW_ASG:
  314.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  315.             cp = (CELL *) (sp-1)->ptr ;
  316.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  317.             cp->dval = pow(cp->dval,sp-- -> dval) ;
  318.             sp->type = C_DOUBLE ;
  319.             sp->dval = cp->dval ;
  320.             break ;
  321.  
  322.         /* will anyone ever use these ? */
  323.  
  324.         case F_ADD_ASG :
  325.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  326.             cp = (CELL *) (sp-1)->ptr ;
  327.             cast1_to_d( cellcpy(&tc, cp) ) ;
  328.             tc.dval += sp-- -> dval ;
  329.             sp->type = C_DOUBLE ;
  330.             sp->dval = tc.dval ;
  331.             field_assign(cp-field, &tc) ;
  332.             break ;
  333.  
  334.         case F_SUB_ASG :
  335.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  336.             cp = (CELL *) (sp-1)->ptr ;
  337.             cast1_to_d( cellcpy(&tc, cp) ) ;
  338.             tc.dval -= sp-- -> dval ;
  339.             sp->type = C_DOUBLE ;
  340.             sp->dval = tc.dval ;
  341.             field_assign(cp-field, &tc) ;
  342.             break ;
  343.  
  344.         case F_MUL_ASG :
  345.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  346.             cp = (CELL *) (sp-1)->ptr ;
  347.             cast1_to_d( cellcpy(&tc, cp) ) ;
  348.             tc.dval *= sp-- -> dval ;
  349.             sp->type = C_DOUBLE ;
  350.             sp->dval = tc.dval ;
  351.             field_assign(cp-field, &tc) ;
  352.             break ;
  353.  
  354.         case F_DIV_ASG :
  355.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  356.             cp = (CELL *) (sp-1)->ptr ;
  357.             cast1_to_d( cellcpy(&tc, cp) ) ;
  358.             tc.dval /= sp-- -> dval ;
  359.             sp->type = C_DOUBLE ;
  360.             sp->dval = tc.dval ;
  361.             field_assign(cp-field, &tc) ;
  362.             break ;
  363.  
  364.         case F_MOD_ASG :
  365.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  366.             cp = (CELL *) (sp-1)->ptr ;
  367.             cast1_to_d( cellcpy(&tc, cp) ) ;
  368.             tc.dval = fmod(tc.dval, sp-- -> dval) ;
  369.             sp->type = C_DOUBLE ;
  370.             sp->dval = tc.dval ;
  371.             field_assign(cp-field, &tc) ;
  372.             break ;
  373.  
  374.         case F_POW_ASG :
  375.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  376.             cp = (CELL *) (sp-1)->ptr ;
  377.             cast1_to_d( cellcpy(&tc, cp) ) ;
  378.             tc.dval = pow(tc.dval, sp-- -> dval) ;
  379.             sp->type = C_DOUBLE ;
  380.             sp->dval = tc.dval ;
  381.             field_assign(cp-field, &tc) ;
  382.             break ;
  383.  
  384.         case _ADD :
  385.             sp-- ;
  386.             if ( TEST2(sp) != TWO_DOUBLES )
  387.                     cast2_to_d(sp) ;
  388.             sp[0].dval += sp[1].dval ;
  389.             break ;
  390.  
  391.         case _SUB :
  392.             sp-- ;
  393.             if ( TEST2(sp) != TWO_DOUBLES )
  394.                     cast2_to_d(sp) ;
  395.             sp[0].dval -= sp[1].dval ;
  396.             break ;
  397.  
  398.         case _MUL :
  399.             sp-- ;
  400.             if ( TEST2(sp) != TWO_DOUBLES )
  401.                     cast2_to_d(sp) ;
  402.             sp[0].dval *= sp[1].dval ;
  403.             break ;
  404.  
  405.         case _DIV :
  406.             sp-- ;
  407.             if ( TEST2(sp) != TWO_DOUBLES )
  408.                     cast2_to_d(sp) ;
  409.             sp[0].dval /= sp[1].dval ;
  410.             break ;
  411.  
  412.         case _MOD :
  413.             sp-- ;
  414.             if ( TEST2(sp) != TWO_DOUBLES )
  415.                     cast2_to_d(sp) ;
  416.             sp[0].dval = fmod(sp[0].dval,sp[1].dval) ;
  417.             break ;
  418.  
  419.         case _POW :
  420.             sp-- ;
  421.             if ( TEST2(sp) != TWO_DOUBLES )
  422.                     cast2_to_d(sp) ;
  423.             sp[0].dval = pow(sp[0].dval,sp[1].dval) ;
  424.             break ;
  425.  
  426.         case _NOT :
  427.         reswitch_1:
  428.             switch( sp->type )
  429.             { case C_NOINIT :
  430.                     sp->dval = 1.0 ; break ;
  431.               case C_DOUBLE :
  432.                     sp->dval =  sp->dval ? 0.0 : 1.0 ;
  433.                     break ;
  434.               case C_STRING :
  435.                     sp->dval = string(sp)->len ? 0.0 : 1.0 ;
  436.                     free_STRING(string(sp)) ;
  437.                     break ;
  438.               case C_STRNUM : /* test as a number */
  439.                     sp->dval = sp->dval ? 0.0 : 1.0 ;
  440.                     free_STRING(string(sp)) ;
  441.                     break ;
  442.               case C_MBSTRN :
  443.                     check_strnum(sp) ;
  444.                     goto reswitch_1 ;
  445.               default :
  446.                     bozo("bad type on eval stack") ;
  447.             }
  448.             sp->type = C_DOUBLE ;
  449.             break  ;
  450.  
  451.         case _TEST :
  452.         reswitch_2:
  453.             switch( sp->type )
  454.             { case C_NOINIT :
  455.                     sp->dval = 0.0 ; break ;
  456.               case C_DOUBLE :
  457.                     sp->dval = sp->dval ? 1.0 : 0.0 ;
  458.                     break ;
  459.               case C_STRING :
  460.                     sp->dval  = string(sp)->len ? 1.0 : 0.0 ;
  461.                     free_STRING(string(sp)) ;
  462.                     break ;
  463.               case C_STRNUM : /* test as a number */
  464.                     sp->dval  = sp->dval ? 0.0 : 1.0 ;
  465.                     free_STRING(string(sp)) ;
  466.                     break ;
  467.               case C_MBSTRN :
  468.                     check_strnum(sp) ;
  469.                     goto reswitch_2 ;
  470.               default :
  471.                     bozo("bad type on eval stack") ;
  472.             }
  473.             sp->type = C_DOUBLE ;
  474.             break ;
  475.  
  476.         case _UMINUS :
  477.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  478.             sp->dval = - sp->dval ;
  479.             break ;
  480.  
  481.         case _UPLUS :  
  482.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  483.             break ;
  484.  
  485.         case _CAT :
  486.             { unsigned len1, len2 ;
  487.               char *str1, *str2 ;
  488.               STRING *b ;
  489.               
  490.               sp-- ;
  491.               if ( TEST2(sp) != TWO_STRINGS )
  492.                     cast2_to_s(sp) ;
  493.               str1 = string(sp)->str ;
  494.               len1 = string(sp)->len ;
  495.               str2 = string(sp+1)->str ;
  496.               len2 = string(sp+1)->len ;
  497.  
  498.               b = new_STRING((char *)0, len1+len2) ;
  499.               (void) memcpy(b->str, str1, len1) ;
  500.               (void) memcpy(b->str + len1, str2, len2) ;
  501.               free_STRING(string(sp)) ;
  502.               free_STRING( string(sp+1) ) ;
  503.  
  504.               sp->ptr = (PTR) b ;
  505.               break ;
  506.             }
  507.  
  508.         case _PUSHINT :
  509.             inc_sp() ;
  510.             sp->type = cdp++ -> op ;
  511.             break ;
  512.  
  513.         case _BUILTIN :
  514.         case _PRINT :
  515.             sp = (* (PF_CP) cdp++ -> ptr) (sp) ;
  516.             break ;
  517.  
  518.         case _POST_INC :
  519.             (void) cellcpy(sp, cp = (CELL *)sp->ptr) ;
  520.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  521.             cp->dval += 1.0 ;
  522.             break ;
  523.  
  524.         case _POST_DEC :
  525.             (void) cellcpy(sp, cp = (CELL *)sp->ptr) ;
  526.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  527.             cp->dval -= 1.0 ;
  528.             break ;
  529.  
  530.         case _PRE_INC :
  531.             cp = (CELL *) sp->ptr ;
  532.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  533.             sp->dval = cp->dval += 1.0 ;
  534.             sp->type = C_DOUBLE ;
  535.             break ;
  536.  
  537.         case _PRE_DEC :
  538.             cp = (CELL *) sp->ptr ;
  539.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  540.             sp->dval = cp->dval -= 1.0 ;
  541.             sp->type = C_DOUBLE ;
  542.             break ;
  543.  
  544.  
  545.         case F_POST_INC  :
  546.             cp = (CELL *) sp->ptr ;
  547.             (void) cellcpy(sp, cellcpy(&tc, cp) ) ;
  548.             cast1_to_d(&tc) ;
  549.             tc.dval += 1.0 ;
  550.             field_assign(cp-field, &tc) ;
  551.             break ;
  552.  
  553.         case F_POST_DEC  :
  554.             cp = (CELL *) sp->ptr ;
  555.             (void) cellcpy(sp, cellcpy(&tc, cp) ) ;
  556.             cast1_to_d(&tc) ;
  557.             tc.dval -= 1.0 ;
  558.             field_assign(cp-field, &tc) ;
  559.             break ;
  560.  
  561.         case F_PRE_INC :
  562.             cp = (CELL *) sp->ptr ;
  563.             cast1_to_d(cellcpy(&tc, cp)) ;
  564.             sp->dval = tc.dval += 1.0 ;
  565.             sp->type = C_DOUBLE ;
  566.             field_assign(cp-field, sp) ;
  567.             break ;
  568.  
  569.         case F_PRE_DEC :
  570.             cp = (CELL *) sp->ptr ;
  571.             cast1_to_d(cellcpy(&tc, cp)) ;
  572.             sp->dval = tc.dval -= 1.0 ;
  573.             sp->type = C_DOUBLE ;
  574.             field_assign(cp-field, sp) ;
  575.             break ;
  576.  
  577.         case _JMP  :
  578.             cdp += cdp->op - 1 ;
  579.             break ;
  580.  
  581.         case _JNZ  :
  582.             /* jmp if top of stack is non-zero and pop stack */
  583.             if ( test( sp ) )
  584.                 cdp += cdp->op - 1 ;
  585.             else  cdp++ ;
  586.             cell_destroy(sp) ;
  587.             sp-- ;
  588.             break ;
  589.  
  590.         case _JZ  :
  591.             /* jmp if top of stack is zero and pop stack */
  592.             if ( ! test( sp ) )
  593.                 cdp += cdp->op - 1 ;
  594.             else  cdp++ ;
  595.             cell_destroy(sp) ;
  596.             sp-- ;
  597.             break ;
  598.  
  599.     /*  the relation operations */
  600.     /*  compare() makes sure string ref counts are OK */
  601.         case  _EQ :
  602.             t = compare(--sp) ;
  603.             sp->type = C_DOUBLE ;
  604.             sp->dval = t == 0 ? 1.0 : 0.0 ;
  605.             break ;
  606.  
  607.         case  _NEQ :
  608.             t = compare(--sp) ;
  609.             sp->type = C_DOUBLE ;
  610.             sp->dval = t ? 1.0 : 0.0 ;
  611.             break ;
  612.  
  613.         case  _LT :
  614.             t = compare(--sp) ;
  615.             sp->type = C_DOUBLE ;
  616.             sp->dval = t < 0 ? 1.0 : 0.0 ;
  617.             break ;
  618.  
  619.         case  _LTE :
  620.             t = compare(--sp) ;
  621.             sp->type = C_DOUBLE ;
  622.             sp->dval = t <= 0 ? 1.0 : 0.0 ;
  623.             break ;
  624.  
  625.         case  _GT :
  626.             t = compare(--sp) ;
  627.             sp->type = C_DOUBLE ;
  628.             sp->dval = t > 0 ? 1.0 : 0.0 ;
  629.             break ;
  630.  
  631.         case  _GTE :
  632.             t = compare(--sp) ;
  633.             sp->type = C_DOUBLE ;
  634.             sp->dval = t >= 0 ? 1.0 : 0.0 ;
  635.             break ;
  636.  
  637.         case  _MATCH :
  638.             /* does sp[-1] match sp[0] as re */
  639.             if ( sp->type != C_RE )  cast_to_RE(sp) ;
  640.  
  641.             if ( (--sp)->type < C_STRING )  cast1_to_s(sp) ;
  642.             t = REtest(string(sp)->str, (sp+1)->ptr) ; 
  643.  
  644.             free_STRING(string(sp)) ;
  645.             sp->type = C_DOUBLE ;
  646.             sp->dval = t ? 1.0 : 0.0 ;
  647.             break ;
  648.  
  649.         case  A_TEST :
  650.         /* entry :  sp[0].ptr-> an array
  651.                     sp[-1]  is an expression
  652.  
  653.            we compute   expression in array  */
  654.             if ( (--sp)->type < C_STRING ) cast1_to_s(sp) ;
  655.             t = array_test( (sp+1)->ptr, string(sp)) ;
  656.             free_STRING(string(sp)) ;
  657.             sp->type = C_DOUBLE ;
  658.             sp->dval = t ? 1.0 : 0.0 ;
  659.             break ;
  660.  
  661.         case  A_DEL :
  662.         /* sp[0].ptr ->  array)
  663.            sp[-1] is an expr
  664.            delete  array[expr]  */
  665.  
  666.             cast1_to_s(--sp) ;
  667.             array_delete( sp[1].ptr , sp->ptr) ;
  668.             free_STRING( string(sp) ) ;
  669.             sp-- ;
  670.             break ;
  671.         
  672.         /* form a multiple array index */
  673.         case A_CAT :
  674.             sp = array_cat(sp, cdp++->op) ;
  675.             break ;
  676.  
  677.         case  _EXIT0 :
  678.             longjmp( exit_jump, 1) ;
  679.  
  680.         case  _EXIT  :
  681.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  682.             exit_code = (int) sp->dval ;
  683.             longjmp( exit_jump, 1) ;
  684.  
  685.         case  _NEXT :
  686.             longjmp(next_jump, 1) ;
  687.  
  688.         case  _RANGE :
  689. /* test a range pattern:  pat1, pat2 { action }
  690.    entry :
  691.        cdp[0].op -- a flag, test pat1 if on else pat2
  692.        cdp[1].op -- offset of pat2 code from cdp
  693.        cdp[2].op -- offset of action code from cdp
  694.        cdp[3].op -- offset of code after the action from cdp
  695.        cdp[4] -- start of pat1 code
  696. */
  697.  
  698. #define FLAG    cdp[0].op
  699. #define PAT2    cdp[1].op
  700. #define ACTION    cdp[2].op
  701. #define FOLLOW    cdp[3].op
  702. #define PAT1      4
  703.  
  704.             if ( FLAG )  /* test again pat1 */
  705.             { 
  706.               (void) execute(cdp + PAT1,sp, fp) ;
  707.               t = test(sp+1) ;
  708.               cell_destroy(sp+1) ;
  709.               if ( t )  FLAG = 0 ;
  710.               else
  711.               { cdp += FOLLOW ;
  712.                 break ;  /* break the switch */
  713.               }
  714.             }
  715.  
  716.             /* test against pat2 and then perform the action */
  717.             (void) execute(cdp + PAT2, sp, fp) ;
  718.             FLAG  = test(sp+1) ;
  719.             cell_destroy(sp+1) ; 
  720.             cdp += ACTION ;
  721.             break ;
  722.  
  723. /* function calls  */
  724.  
  725.       case  _RET0  :
  726.             inc_sp() ;
  727.             sp->type = C_NOINIT ;
  728.             /* fall thru */
  729.  
  730.       case  _RET   :
  731.  
  732. #ifdef  DEBUG
  733.             if ( sp != entry_sp+1 ) bozo("ret") ;
  734. #endif
  735.             returning = 1 ;
  736.             return  cdp-1 ;
  737.  
  738.       case  _CALL  :
  739.  
  740.             { FBLOCK *fbp = (FBLOCK*) cdp++->ptr ;
  741.               int a_args = cdp++->op ; /* actual number of args */
  742.               CELL *nfp = sp - a_args + 1 ; /* new fp for callee */
  743.               CELL *local_p = sp+1; /* first local argument on stack */
  744.               char *type_p ;  /* pts to type of an argument */
  745.  
  746.               if ( fbp->nargs ) type_p = fbp->typev + a_args ;
  747.  
  748.               /* create space for locals */
  749.               if ( t = fbp->nargs - a_args ) /* have local args */
  750.               {
  751.                 if ( sp + t >= eval_stack + EVAL_STACK_SIZE - SAFETY )
  752.                    eval_overflow() ;
  753.  
  754.                 while ( t-- )  
  755.                 { (++sp)->type = C_NOINIT ;
  756.                   if ( *type_p++ == ST_LOCAL_ARRAY )
  757.                         sp->ptr = (PTR) new_ARRAY() ;
  758.                 }
  759.               }
  760.               type_p-- ; /* *type_p is type of last arg */ 
  761.  
  762.               (void) execute(fbp->code, sp, nfp) ;
  763. #ifdef  DEBUG
  764. if ( !returning )  bozo("call") ;
  765. #endif
  766.               returning = 0 ;
  767.  
  768.               /* cleanup the callee's arguments */
  769.               if ( sp >= nfp ) 
  770.               {
  771.                 cp = sp+1 ;  /* cp -> the function return */
  772.  
  773.                 do
  774.                 {
  775.                   if ( *type_p-- == ST_LOCAL_ARRAY )
  776.                   {  if ( sp >= local_p ) array_free(sp->ptr) ; }
  777.                   else  cell_destroy(sp) ;
  778.  
  779.                 } while ( --sp >= nfp ) ;
  780.                     
  781.                 (void) cellcpy(++sp, cp) ;
  782.                 cell_destroy(cp) ;
  783.               }
  784.               else  sp++ ; /* no arguments passed */
  785.             }
  786.             break ;
  787.  
  788.         default :
  789.             bozo("bad opcode") ;
  790.     }
  791. }
  792.  
  793. int test( cp )  /* test if a cell is null or not */
  794.   register CELL *cp ;
  795. { 
  796. reswitch :
  797.  
  798.   switch ( cp->type )
  799.   {
  800.     case C_NOINIT :  return  0 ;
  801.     case C_STRNUM :  /* test as a number */
  802.     case C_DOUBLE :  return  cp->dval != 0.0 ;
  803.     case C_STRING :  return  string(cp)->len ;
  804.     case C_MBSTRN :  check_strnum(cp) ; goto reswitch ;
  805.  
  806.     default :
  807.       bozo("bad cell type in call to test") ;
  808.   }
  809. }
  810.  
  811. /* compare cells at cp and cp+1 and
  812.    frees STRINGs at those cells
  813. */
  814.  
  815. static int compare(cp)
  816.   register CELL *cp ;
  817. { int k ;
  818.  
  819. reswitch :
  820.  
  821.   switch( TEST2(cp) )
  822.   { case TWO_NOINITS :  return 0 ; 
  823.     
  824.     case TWO_DOUBLES :
  825.     two_d:
  826.             return  cp->dval > (cp+1)->dval ? 1 :
  827.                     cp->dval < (cp+1)->dval ? -1 : 0 ;
  828.     
  829.     case TWO_STRINGS :
  830.     case STRING_AND_STRNUM :
  831.     two_s:
  832.             k = strcmp(string(cp)->str, string(cp+1)->str) ;
  833.             free_STRING( string(cp) ) ;
  834.             free_STRING( string(cp+1) ) ;
  835.             return k ;
  836.  
  837.     case  NOINIT_AND_DOUBLE  :
  838.     case  NOINIT_AND_STRNUM  :
  839.     case  DOUBLE_AND_STRNUM  :
  840.     case TWO_STRNUMS :
  841.             cast2_to_d(cp) ; goto two_d ;
  842.  
  843.     case  NOINIT_AND_STRING  :
  844.     case  DOUBLE_AND_STRING  :
  845.             cast2_to_s(cp) ; goto two_s ;
  846.  
  847.     case  TWO_MBSTRNS :
  848.             check_strnum(cp) ; check_strnum(cp+1) ;
  849.             goto reswitch ;
  850.  
  851.     case  NOINIT_AND_MBSTRN :
  852.     case  DOUBLE_AND_MBSTRN :
  853.     case  STRING_AND_MBSTRN :
  854.     case  STRNUM_AND_MBSTRN :
  855.             check_strnum( cp->type == C_MBSTRN ? cp : cp+1 ) ;
  856.             goto reswitch ;
  857.  
  858.     default :  /* there are no default cases */
  859.             bozo("bad cell type passed to compare") ;
  860.   }
  861. }
  862.  
  863. /* does not assume target was a cell, if so
  864.    then caller should have made a previous
  865.    call to cell_destroy  */
  866.  
  867. CELL *cellcpy(target, source)
  868.   register CELL *target, *source ;
  869. { switch( target->type = source->type )
  870.   { case C_NOINIT : 
  871.     case C_SPACE  : 
  872.     case C_SNULL  :
  873.             break ;
  874.  
  875.     case C_DOUBLE :
  876.             target->dval = source->dval ;
  877.             break ;
  878.  
  879.     case C_STRNUM :
  880.             target->dval = source->dval ;
  881.             /* fall thru */
  882.  
  883.     case C_REPL    :
  884.     case C_MBSTRN  :
  885.     case C_STRING  :
  886.             string(source)->ref_cnt++ ;
  887.             /* fall thru */
  888.  
  889.     case C_RE  :
  890.             target->ptr = source->ptr ;
  891.             break ;
  892.  
  893.     case  C_REPLV :
  894.             (void)  replv_cpy(target, source) ;
  895.             break ;
  896.  
  897.     default :
  898.             bozo("bad cell passed to cellcpy()") ;
  899.             break ;
  900.   }
  901.   return  target ;
  902. }
  903.  
  904. #ifdef   DEBUG
  905.  
  906. void  DB_cell_destroy(cp)    /* HANGOVER time */
  907.   register CELL *cp ;
  908. {
  909.   switch( cp->type )
  910.   { case C_NOINIT :
  911.     case C_DOUBLE :  break ;
  912.  
  913.     case C_MBSTRN :
  914.     case C_STRING :
  915.     case C_STRNUM :
  916.             if ( -- string(cp)->ref_cnt == 0 )
  917.                 zfree(string(cp) , string(cp)->len+5) ;
  918.             break ;
  919.  
  920.     case  C_RE :
  921.             bozo("cell destroy called on RE cell") ;
  922.     default :
  923.             bozo("cell destroy called on bad cell type") ;
  924.   }
  925. }
  926.  
  927. #endif
  928.